'###########################################################################
'#                                                                         #
'#                  D X C C   Personal Statistic Keeper                    #
'#                                 by                                      #
'#                      Bj. Madsen  -+-  VE5FX                             #
'#                              Feb. 1987                                  #
'#                                                                         #
'###########################################################################
'
'This program is designed to keep track of your personal DXCC data, and will
'allow you to make displays or printouts formatted in a viriety of ways.
'
'                           IMPORTANT VARIABLES:
'          P$ = Prefix of country              C$ = Name of country
'         CS$ = Callsign worked                S$ = Status (wrk./conf.)
'
CLEAR 500 : MYCALL$ = "VE5FX"
DIM CS$(330) : DIM S$(330) :  SET = 0          'SET - have we current date?
LET N = 316                           'set value of N to number of countries
'
'----------------------------------------------------------------  Show.Menu
SHOWMENU:
   CLS:M$ = MYCALL$ + " - DXCC Statistics ":GOSUB BORDERS
   LOCATE  9,25: PRINT "1.  Enter a new country."
   LOCATE 10,25: PRINT "2.  List all DXCC data."
   LOCATE 11,25: PRINT "3.  List countries worked."
   LOCATE 12,25: PRINT "4.  List all countries needed."
   LOCATE 13,25: PRINT "5.  Show statistics only."
   LOCATE 14,25: PRINT "6.  Load data file from disk."
   LOCATE 15,25: PRINT "7.  Save data file to disk."
   LOCATE 16,25: PRINT "8.  End program."
   LOCATE 20,20: INPUT"What is your choice ....";C
   ON C GOSUB ENTERIT,LISTALL,LISTALL,LISTALL,LISTSTAT,LOADIT,SAVEIT,ENDIT
 GOTO SHOWMENU
'----------------------------------------------------------------  Enter.It
ENTERIT:
   IF SET=0 THEN GOSUB GETDATE: CHANGEDIT = 1
   M$ = MYCALL$ + " - ENTER A NEW DXCC CONTACT: ":GOSUB BORDERS:LINE(50,67)-(550,82),3,B
   LOCATE 10,15:INPUT"What is the callsign";CS$ : COLOR 1,0
      FOR L = 2 TO LEN(CS$)
        IF ASC(MID$(CS$,L,1)) < 58 THEN P = L - 1        'find position of number
      NEXT L
      RESTORE : X = 0
    READIT:
      READ P$,C$ : X = X+1 : FLAG = 1
        IF P$ = "END" THEN NOTFOUND
        IF LEFT$(P$,P) = LEFT$(CS$,P) THEN SHOWIT
      GOTO READIT
    SHOWIT:
      LINE (50,125)-(550,145),3,B: GOSUB BIGWIPE
      LOCATE 17,15: PRINT "Found: ";P$;" is the prefix for ";C$
        IF CS$(X) = "" THEN M$ = "[No callsign Currently ON file]" :ELSE M$ = "[Currently ON file is: "+CS$(X)+"]"
        LOCATE 18,20 : PRINT M$
        GOSUB WIPE: LOCATE 10,15: PRINT "Do you want to <S>ave ";CS$;" or <P>ass";
       GETKEY:
        A$=INKEY$
          IF A$ = "S" THEN CS$(X) = CS$ : GOTO QSL
          IF A$ = "P" AND FLAG = 1 THEN READIT
          IF A$ = "P" AND FLAG = 2 THEN READAGN
         GOTO GETKEY
       QSL:
          GOSUB WIPE:LOCATE 10,15:PRINT "Has ";CS$;" been confirmed <Y>es or <N>o?";
         GETQSL:
           A$=INKEY$
             IF A$ = "Y" THEN S$(X) = "o.k."    : GOTO DONE
             IF A$ = "N" THEN S$(X) = "?"       : GOTO DONE
            GOTO GETQSL
       NOTFOUND:
          LINE (50,125)-(550,145),3,B
          GOSUB BIGWIPE: LOCATE 17,15: PRINT "The prefix ";LEFT$(CS$,P);" is not on file."
          GOSUB WIPE: LOCATE 10,15: INPUT"What is the name of the country";CN$
          RESTORE : X = 0
       READAGN:
          READ P$,C$: X = X+1: FLAG = 2           'read prefix & country name
            IF C$ = "END" THEN CANTFIND
            IF LEFT$(C$,4) = LEFT$(CN$,4) THEN SHOWIT
          GOTO READAGN
       CANTFIND:
          GOSUB WIPE: LOCATE 10,15: PRINT "You will have to enter ";CS$;" the hard way" 
          GOSUB BIGWIPE :LOCATE 10,15: INPUT"Press <ENTER> to return to menu ...";Q$
       DONE:
          RETURN
'------------------------------------------------------------------- List.All
LISTALL:
   M$ = MYCALL$ + " - LIST DXCC DATA: ": GOSUB BORDERS: LINE (50,67)-(550,82),3,B
   LOCATE 10,15:INPUT"List to <P>rinter or <S>creen...";Q$
   IF LEFT$(Q$,1)="P" OR LEFT$(Q$,1)="p" THEN PRINTIT
   M$ = "":GOSUB BORDERS
     LOCATE 2,4:PRINT TAB(3)" No. ";TAB(10)" Prefix: ";TAB(27)" Country: ";TAB(57)" Worked: ";TAB(69)" Status:"
       LET X = 1: WK = 0: NC = 0 : RESTORE
    BIGLOOP:
       LOCATE 6,2 : L = 0
    LOOPREAD:   
         READ P$,C$
           IF P$ = "END" THEN THATSALL
            IF C=2 THEN GOSUB SHOWLINE   : L = L + 1
            IF C=3 AND CS$(X) <> "" THEN GOSUB SHOWLINE  : L = L + 1
            IF C=4 AND CS$(X) = "" THEN GOSUB SHOWLINE   : L = L + 1
           IF CS$(X) <> "" THEN WK = WK + 1              'stations worked
           IF S$(X) = "?"  THEN NC = NC + 1              'stations not confirmed
         X = X + 1
         IF L = 15 THEN GOSUB WAITABIT : LINE (11,38)-(605,180),0,BF :IF A$="M" THEN RETURN :ELSE BIGLOOP
       GOTO LOOPREAD
       THATSALL:
         PRINT " ":PRINT TAB(30)STRING$(45,"=");
         PRINT TAB(30)"Total countries worked ........ ";WK;"/";(X-1)
         PRINT TAB(30)"Total countries confirmed ..... ";WK-NC
         PRINT TAB(30)"Total countries still needed .. ";N-WK
        GOSUB WAITABIT
        RETURN
     PRINTIT:
       GOSUB WIPE:LOCATE 10,15:INPUT"Make sure printer is ready and press <ENTER> ...";Q$
       LET X = 1: WK = 0 : NC = 0 : RESTORE
         OPEN "PRT:" FOR OUTPUT AS #1
         PRINT #1,CHR$(27)"[""1""m"
         PRINT #1,"DXCC Data for: "MYCALL$
         PRINT #1,"    Dated: "TODAY$
           IF C=2 THEN PRINT #1,"[All DXCC Data:]"
           IF C=3 THEN PRINT #1,"[Countries Worked:]"
           IF C=4 THEN PRINT #1,"[Countries Needed:]"
         PRINT #1,CHR$(27)"[""22""m"
         PRINT #1,CHR$(27)"[""4""w"
         PRINT #1,STRING$(78,"=")
         PRINT #1,TAB(4)"No.";TAB(11)"Prefix:";TAB(30)"Country:";TAB(60)"Worked:";TAB(71)"Status:"
         PRINT #1,STRING$(78,"=")
       LOOPREAD2:
          READ P$,C$
            IF P$ = "END" THEN THATSALL2
              IF C=2 THEN GOSUB PRINTLINE
              IF C=3 AND CS$(X) <> "" THEN GOSUB PRINTLINE
              IF C=4 AND CS$(X) = "" THEN GOSUB PRINTLINE
            IF CS$(X) <> "" THEN WK = WK + 1
            IF S$(X) = "?"  THEN NC = NC + 1
            X = X + 1
          GOTO LOOPREAD2
       THATSALL2:
          PRINT #1," ":PRINT #1," ":PRINT #1,STRING$(70,"_")
          PRINT #1,TAB(30)"Total countries worked ........";WK;"/";(X-1)
          PRINT #1,TAB(30)"Total countries confirmed .....";WK-NC
          PRINT #1,TAB(30)"Total countries still needed ..";NC
          PRINT #1,CHR$(27)"[""3""w"
          CLOSE #1
        RETURN
'----------------------------------------------------------------- List.Stat
LISTSTAT:
   M$= MYCALL$ + " - DXCC Statistics: ":GOSUB BORDERS
   WK = 0 : NC = 0
   FOR X = 1 TO N
     IF CS$(X) <> "" THEN WK = WK + 1
     IF S$(X) = "?"  THEN NC = NC + 1 
   NEXT X
        LOCATE  8,15: PRINT "DXCC Data for ";MYCALL$;" dated ";TODAY$;":"
        LOCATE 10,15: PRINT STRING$(60,"="):PRINT
        PRINT TAB(30)"Total countries on file ....";N
        PRINT TAB(30)"Total countries worked .....";WK
        PRINT TAB(30)"Total countries confirmed ..";WK-NC
        PRINT TAB(30)"Countries left to work .....";N-WK
     GOSUB WAITABIT
   RETURN
'------------------------------------------------------------------- Load.It
LOADIT:
   LET N = 1                                    'reset counter to start
   M$= MYCALL$ + " - DXCC Statistics: ":GOSUB BORDERS
   LOCATE 13,20: PRINT"Loading DXCC data from disk:": COLOR 1,0
   OPEN "I",#1,"DXCC.DAT"
      INPUT #1,TODAY$
     WHILE NOT EOF(1)
        INPUT #1,CS$(N)                          'callsign worked
        INPUT #1,S$(N)                           'status {confirmed?}
        LET N = N + 1
     WEND
        LET N = N - 1                            'reset counter
   CLOSE : COLOR 1
   RETURN
'------------------------------------------------------------------- SAVE.IT
SAVEIT:
   M$ = MYCALL$ + " - DXCC Statistics: ":GOSUB BORDERS:LINE(50,67)-(550,82),3,B
   IF TODAY$ = "" THEN LOCATE 10,15:PRINT"DANGER!!!     No data on file!":GOSUB WAITABIT:RETURN
   LOCATE 10,15: PRINT "Saving DXCC data to disk: ":COLOR 1,0
   OPEN "DF1:DXCC.DAT" FOR OUTPUT AS #1
      PRINT #1,TODAY$
        FOR X = 1 TO N
           PRINT #1,CS$(X)                       'callsign worked
           PRINT #1,S$(X)                        'status {confirmed}
        NEXT X  
    CLOSE #1
    SAVEIT = 1
 RETURN
'------------------------------------------------------------------ End.It
ENDIT:
   IF SAVEIT = 1 OR CHANGEDIT = 0 THEN END
   M$ = "END OF PROGRAM":GOSUB BORDERS
   LOCATE 10,15:PRINT"Changes have been made to data since the last Save..."
   GOSUB WAITABIT
  RETURN
'------------------------------------------------------------------ Get.Date
GETDATE:
   M$ = "Open a new DXCC file ":GOSUB BORDERS:LINE (50,67)-(550,82),3,B
   LOCATE 10,15: INPUT"What is today's date <07 Feb 87> ";TODAY$
   SET = 1
  RETURN
'------------------------------------------------------------------ Borders
BORDERS:
   CLS:LINE (0,0)-(640,5),3,BF : LINE (0,0)-(10,200),3,BF
   LINE (607,0)-(617,200),3,BF : LINE (0,181)-(617,186),3,BF
   LINE (0,30)-(640,35),3,BF   : PAINT (20,10),2,3 : PAINT (20,33),1,3 
   COLOR 3,2 : LOCATE 3,25: PRINT M$ : COLOR 1,0
 RETURN
'--------------------------------------------------------------- Show.Line
SHOWLINE:
   PRINT TAB(3)X;"....";TAB(12)P$;TAB(27)C$;TAB(57)CS$(X);TAB(70)S$(X)
  RETURN
'--------------------------------------------------------------- Print.Line 
PRINTLINE:  
   PRINT#1,X;"....";TAB(13)P$;TAB(27)C$;TAB(57)CS$(X);TAB(70)S$(X) 
  RETURN 
'------------------------------------------------------------------- Wipe
WIPE:
   LOCATE 10,15 : PRINT STRING$(50," ") : RETURN
'----------------------------------------------------------------- Big.Wipe
BIGWIPE:
   LOCATE 17,15 : PRINT STRING$(50," ")
   LOCATE 18,15 : PRINT STRING$(50," ") : RETURN
'--------------------------------------------------------------- Wait.a.Bit       
WAITABIT:
   LOCATE 22,15 : PRINT "Press any key to continue or <M> for Menu ....";
  GOAGAIN:
     A$ = INKEY$ : IF A$ = "" THEN GOAGAIN
     RETURN
'--------------------------------------------------------- Data.Begins.Here      
'
DATA A22,BOTSWANA,A3,"TONGA, Republic of",A4X,OMAN,A4,BHUTAN,A6X,UNITED ARAB EMIRATES,A71,QUATAR,A9X,BAHRAIN,AP,PAKISTAN,BV,TAIWAN
DATA BY,CHINA,C2,"NAURU, Republic of",C3,ANDORRA,C5,THE GAMBIA,C6,BAHAMAS,C9,MOZAMBIQUE,CE,CHILE,KC4,ANTARCTICA,CE0A,EASTER ISLAND
DATA CE0X,SAN FELIX,CE0Z,JUAN FERNANDEZ,CM-CO,CUBA,CN,MOROCCO,CP,BOLIVIA,CR9,MACAO,CT,PORTUGAL,"CU,CT2",AZORES IS.,CT3,MADEIRA IS.
DATA CX,URUGUAY,D2-3,ANGOLA,D4,"CAPE VERDE, Republic of",D6,COMOROS,DA-DL,"GERMANY, Fed. Republic of",DU,PHILLIPINES IS.,EA,SPAIN
DATA EA6,BALEARIC IS.,EA8,CANARY IS.,EA9,CEUTA & MELILLA,EI,IRELAND,EL,LIBERIA,EP,IRAN,ET,ETHOPIA,F,FRANCE,FB8W,CROZET
DATA "FT8,FB8X",KERGUELEN IS.,FB8Z,AMSTERDAM & ST. PAUL IS.,FC,CORSICA,FG,GUADELOUPE,"FS,FG",SAINT MARTIN,FH,MAYOTTE,FK,NEW CALEDONIA
DATA FM,MARTINIQUE,FO,CLIPPERTON IS.,FO,FRENCH POLYNESIA,FP,ST. PIERRE & MIQUELON IS.,FR,GLORIOSO IS.,FR,JUAN DE NOVA IS.,FR,REUNION IS.
DATA FR,TROMELIN IS.,FW,WALLIS & FORTUNA IS.,FY,FRENCH GUIANA,G,ENGLAND,"GD,GT",ISLE OF MAN,GI,NORTHERN IRELAND,"GJ,GC",JERSEY IS.
DATA GM,SCOTLAND,"GU,GC",GURNSEY IS.,GW,WALES,"H4,VR4",SOLOMON IS.,"HA,HG",HUNGARY,HB,SWITZERLAND,HB0,LICHENSTEIN,HC,ECUADOR
DATA "HC8,HD8",GALAPAGOS IS.,HH,HAITI,HI,DOMINICAN REPUBLIC,HK,COLOMBIA,HK0,MALPELO,HK0,SAN ANDRES IS.,"HL,HM",KOREA,"HP,H31",PANAMA
DATA HR,HONDURAS,HS,THAILAND,HV,VATICAN,"HZ,7Z",SAUDI ARABIA,"I,IT",ITALY,IS,SARDINIA,"J2,FL8",DJIBOUTI,"J3,VP2G",GRANADA
DATA "J5,CR3",GUINEA-BISSAU,"J6,VP2L",ST. LUCIA,"J7,VP2D",DOMINICA,"J88,VP2S",ST. VINCENT & DEPENDENCIES,JA-JO,JAPAN
DATA "JD,KA1",MINAMI TORISHIMA,"JD,KA1",OGASAWARA,JT,MONGOLIA,JW,SVALBARD,JX,JAN MAYEN IS.,JY,JORDAN,"W,K,N,A",UNITED STATES
DATA KH1,"BAKER, HOWLAND & PHOENIX IS.","KC4,KP1",NAVASSA IS.,KC6,E. CAROLINES (Micronesia),KC6,W. CAROLINES (Rep of Belau)
DATA KG4,GUANTANAMO BAY,"KH2,KG6",GUAM,"KH0,KG6",MARIANA IS.,KH6,HAWAII,KH7,KURE IS.,"KH3,KJ",JOHNSTON IS.,KL7,ALASKA,"KH4,KM",MIDWAY IS.
DATA KP4,PUERTO RICO,"KP2,4,5",DESECHEO IS.,"KH5K,KP6",KINGMAN REEF,"KH5,KP6",PALMYRA & JARVIS IS.,"KH8,KS6",AMERICAN SAMOA
DATA "KP2,KV",VIRGIN IS.,"KH9,KW",WAKE IS.,KX,MARSHALL IS.,LA-LJ,NORWAY,LU,ARGENTINA,LX,LUXEMBOURG,LZ,BULGARIA,OA,PERU,OD,LEBANON
DATA OE,AUSTRIA,OH,FINLAND,OH0,ALAND IS.,OJ0,MARKET REEF,OK,CZECHOSLOVAKIA,ON,BELGIUM,"OX,XP",GREENLAND,OY,FAROE IS.,OZ,DENMARK
DATA P2,PAPUA NEW GUINEA,PA-PI,NETHERLANDS,"PJ,P41,2",NETHERLANDS ANTILLES,"PJ,P47","ST. MAARTEN,SABA, etc.",PY,BRAZIL
DATA PY0,FERNANDO NORONHA,PY0,ST. PETER & PAUL ROCKS,PY0,TRINIDADE & MARTIN VAZ IS.,PZ,SURINAM,S2,BANGLADESH
DATA S7,SEYCHELLES IS.,S9,SAO TOME PRINCIPE,SK-SM,SWEDEN,SP,POLAND,"ST,6T1",SUDAN,ST0,SOUTHERN SUDAN
DATA SU,EGYPT,SV,GREECE,SV,CRETE,SV5,DODECANESE IS.,SV,MOUNT ATHOS,"T2,VR8",TUVALU,"T31,VR1",CENTRAL KIRIBATI
DATA "T30,VR1",WEST KIRIBATI,"T32,VR3",EAST KIRIBATI,TA,TURKEY,TF,ICELAND,TG,GUATEMALA,TI,COSTA RICA,TI9,COCOS IS.,TJ,CAMAROON
DATA TL,CENTRAL AFRICAN REPUBLIC,TN,CONGO,TR,GABONESE REPUBLIC,TT,CHAD,TU,IVORY COAST,TY,BENIN,TZ,MALI,"UA,UK,UW,UV",EUROPEAN R.S.F.S.R.
DATA "UA1,UK1",FRANZ JOSEF LAND,"UA2,UK2F",KALININGRADSK,"UA,UK,UV,UW9-0",ASIATIC R.S.F.S.R.,"UB,UK,UT,UY5",UKRAINE,"UC,UK2A",WHITE R.S.S.R
DATA "UD6,UK6C,/D/K",AZERBAIJAN,"UF6,UK6F",GEORGIA,"UG6,UK6G",ARMENIA,"UH8,UK8H",TURKOMAN,"UI8,UK8",UZBEK,"UJ8,UK8J,R",TADZHIK
DATA "UL7,UK7",KAZAKH,"UM8,UK8M/N",KIRGHIZ,"UO5,UK5O",MOLDAVIA,"UP2,UK2B/P",LITHUANIA,"UQ2,UK2G/Q",LATVIA,"UR2,UK2R/T",ESTONIA,"VE,VO,VY",CANADA
DATA CY0SAB,SABLE IS.,CY9SPI,ST. PAUL IS.,VK,AUSTRALIA,VK,LORD HOWE IS.,VK9,WILLIS IS.,VK9X,CHRISTMAS IS.,VK9Y,COCOS-KEELING IS.
DATA VK9,MELLISH REEF,VK9N,NORFOLK IS.,VK0,HEARD IS.,VK0,MACQUARIE IS.,"V3A,VP1",BELISE,"V2A,VP2A","ANTIGUA, BARBUDA IS.",VP2E,ANGUILLA
DATA "V4,VP2K","ST. KITTS, NEVIS IS.",VP2M,MONTSERRAT,VP2V,BRITISH VIRGIN IS.,VP5,"TURKS & CAICOS IS.",VP8,FALKLAND IS.,"VP8,LU-Z",SOUTH GEORGIA IS.
DATA "VP8,LU-Z",SOUTH ORKNEY IS.,"VP8,LU-Z",SOUTH SANDWICH IS.,"VP8,LU-Z",SOUTH SHETLAND IS.,VP9,BERMUDA IS.,VQ9,CHAGOS IS.,VR6,PITCAIRN IS.
DATA "V85,VS5",BRUNEI,VS6,HONGKONG,VU,INDIA,VU7,ANDAMAN & NICOBAR IS.,VU7,LACCADIVE IS.,XE,MEXICO,XF4,REVILLA GIGEDO IS.,XT,"BURKINO FASO, Rep. of"
DATA XU,KHMER REPUBLIC,XV,VIETNAM,XW,LAO PEOPLE'S DEM. REP.,XZ,BURMA,Y1-0,GERMAN DEMOCRATIC REP.,YA,AFGHANISTAN,YB-C,INDONESIA
DATA YI,IRAQ,YJ,NEW HEBRIDES (Vanatu),YK,SYRIA,"YN,HT",NICARAGUA,YO,ROMANIA,YS,SALVADOR,"YU,YT,YZ",YUGOSLAVIA,YV,VENEZUELA
DATA YV0,AVES IS.,ZA,ALBANIA,ZB,GIBRALTAR,ZC4,CYPRUS (Sov. Base Area),ZD7,ST. HELENA IS.,ZD8,ASCENSION IS.,ZD9,TRISTAN DE CUNHA IS.
DATA "Z2,ZE",ZIMBABWE,ZF,CAYMAN IS.,ZK1,SOUTH COOK IS.,ZK3,NORTH COOK IS.,ZK2,NIUE,ZL,NEW ZELAND,ZL9,AUCKLAND & CAMPBELL IS.
DATA ZL7,CHATHAM IS.,ZL8,KERMANDEC IS.,"ZM7,ZK3",TOKELAUS IS.,ZP,PARAGUAY,"ZS1-6,S88",SOUTH AFRICA & TRANSKEI,ZS2,PRINCE EDWARD IS.
DATA ZS3,NAMIBIA,1A,S.M.O. KNIGHTS OF MALTA,1S,SPRATLEY IS.,3A,MONACO,"3B6,7",AGELEGA & ST. BRANDON IS.,3B8,MAURITIUS IS.,3B9,RODRIGUEZ IS.
DATA 3C,EQUATORIAL GUINEA,3C0,ANNOBON IS.,3D2,FIJI IS.,3D6,SWAZILAND,3V,TUNISIA,3X,"GUINEA, Republic of",3Y,BOUVET,4S,SRI LANKA
DATA 4U1ITU,I.T.U. GENEVA,4U1UN,UNITED NATIONS HQ.,4W,YEMEN,"4X,4Z",ISRAEL,5A,LIBYA,"5B,ZC",CYPRUS,5H,TANZANIA,5N,NIGERIA
DATA 5R,MALAGASY REPUBLIC,5T,MAURITANIA,5U,NIGER,5V,TOGO,5W,WESTERN SAMOA,5X,UGANDA,5Z,KENYA,"T5,6O",SOMALIA,6W,SENEGAL,6Y,JAMAICA
DATA 7O,"YEMEN, People's Rep.",7P,LESOTHO,7Q,MALAWI,7X,ALGERIA,8P,BARBADOS,"8Q,VS9",MALDIVE IS.,8R,GUYANA,"T7,9A,M1",SAN MARINO,9G,GHANA
DATA 9H,MALTA,9J,ZAMBIA,9K,KUWAIT,9L,SIERRA LEONE,9M2,WEST MALAYSIA,"9M6,8",EAST MALAYSIA,9N,NEPAL,9Q,ZAIRE,9U,BURUNDI,9V,SINGAPORE
DATA 9X,RWANDA,9Y,TRINIDAD & TOBAGO," ","ABU AIL, JABAL AT TAIR"
DATA END,END